perm filename DEKODE.F4[M11,LCS] blob
sn#404805 filedate 1978-12-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE DEKODE(KODE)
C00007 ENDMK
C⊗;
SUBROUTINE DEKODE(KODE)
DIMENSION M(80),VV(4)
COMMON J
COMMON /ALPH/IALPH(14)
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
DATA KSLA/'/'/
1 ,ISCA/'C','P','D','O','E','F','Z','G','S','A','T','B'/
1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
1,IALPH/'H','I','J','K','L','M','N','Q','R','U','V','W','X'
1,'Y'/
EQUIVALENCE (M,INP),(VV,VX)
EQUIVALENCE (IEE,ISCA(5)),(IDD,ISCA(3)),(IMM,IALPH(6))
1,(ITT,ISCA(11)),(III,IALPH(2)),(IYY,IALPH(14)),
1(INN,IALPH(7)),(IOO,ISCA(4)),(IFF,ISCA(6)),(IHH,IALPH(1)),
1(ILL,IALPH(5)),(IPP,ISCA(2)),(ICC,ISCA),(IRR,IALPH(9)),
1(ISS,ISCA(9)),(IHH,IALPH),(IUU,IALPH(10)),(III,IALPH(2))
1 FORMAT(80A1)
ML=1
5 READ(23,1,END=2)M
DO 3 K=80,1,-1
3 IF(M(K).NE.IBLA)GO TO 4
GO TO 5
4 DO 6 I=1,K
L=M(I)
C PUT IN TRAP FOR TAB AND <
L2=M(I+1)
L3=M(I+2)
L4=M(I+3)
L5=M(I+4)
IF(L.EQ.IBLA)GO TO 7
IF(L.NE.IPP)GO TO 8
IF(L2.NE.IRR)GO TO 16
IF(L3.NE.IEE)GO TO 22
IF(L4.NE.ICC)GO TO 22
IF(L5.NE.IEE)GO TO 22
C NOW FOUND 'PRECEDE'
KODE=7
RETURN
16 IF(L2.NE.ILL)GO TO 22
IF(L3.NE.IAA)GO TO 22
IF(L4.NE.IYY)GO TO 22
IF(L5.NE.IBLA)GO TO 22
C NOW FOUND 'PLAY' SECTION
ML=6
KODE=4
RETURN
8 IF(L.NE.IRR)GO TO 10
IF(L2.NE.IUU)GO TO 22
IF(L3.NE.INN)GO TO 22
IF(L4.NE.IBLA.AND.L4.NE.ISEMI)GO TO 22
C NOW FOUND 'RUN'
KODE=2
RETURN
10 IF(L.NE.ITT)GO TO 12
IF(L2.NE.IEE)GO TO 22
IF(L3.NE.IMM)GO TO 22
IF(L4.NE.IPP)GO TO 22
IF(L5.NE.IOO)GO TO 22
DO 14 KK=I+5,K
14 IF(M(KK).EQ.KSLA)GO TO 15
15 ML=KK+1
C FOUND 'TEMPO'
KODE=3
RETURN
12 IF(L.NE.III)GO TO 17
IF(L2.NE.INN)GO TO 22
IF(L3.NE.ISS)GO TO 22
IF(L4.NE.IEE)GO TO 22
IF(L5.NE.IRR)GO TO 22
C FOUND 'INSERT'
ML=7
KODE=5
RETURN
17 IF(L.NE.IFF)GO TO 19
IF(L2.NE.III)GO TO 22
IF(L3.NE.INN)GO TO 22
IF(L4.NE.III)GO TO 22
IF(L5.NE.ISS)GO TO 22
C 'FINISH' IS SAME AS 'END SECTION'
IF(I(K+5).NE.IHH)GO TO 22
21 KODE=6
RETURN
19 IF(L.NE.IEE)GO TO 11
IF(L2.NE.INN)GO TO 9
IF(L3.NE.IDD)GO TO 22
IF(L4.NE.IBLA)GO TO 22
C 'END SECTION'
IF(L5.EQ.ISS)GO TO 21
9 IF(L2.NE.IDD)GO TO 22
IF(L3.NE.III)GO TO 22
IF(L4.NE.ITT)GO TO 22
C FOUND 'EDIT'
KODE=8
RETURN
11 IF(L.NE.ISS)GO TO 22
IF(L2.NE.IEE)GO TO 22
IF(L3.NE.ICC)GO TO 22
IF(L4.NE.ITT)GO TO 22
IF(L5.NE.III)GO TO 22
C FOUND 'SECTION'
KODE=9
RETURN
C↓↓↓ NOW IT MUST BE AND INSTR. NAME.
22 DO 24 KK=I+1,K
L=M(KK)
IF(L.EQ.ISEMI)GO TO 25
24 IF(L.EQ.IBLA)GO TO 25
C***** HERE UP TO 4 CHARS WILL BE PACKED INTO 'J'
25 DO 26 JJ=KK,K
26 IF(M(JJ).EQ.ISEMI)GO TO 27
C IF NO SEMICOLON THEN ERROR
CALL ERROR(1)
27 ML=JJ+1
KODE=1
GO TO (1,101,102,103,104)KK
C*** NEXT IS FOR PDP10 ONLY *****
201 FORMAT(A1,4F)
202 FORMAT(A2,4F)
203 FORMAT(A3,4F)
204 FORMAT(A4,4F)
101 REREAD 201,J,VV
RETURN
102 REREAD 202,J,VV
RETURN
103 REREAD 203,J,VV
RETURN
104 REREAD 204,J,VV
RETURN
END